home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / LISTBOX / FILE32 / FILE32.PAS < prev    next >
Pascal/Delphi Source File  |  1995-12-16  |  4KB  |  155 lines
  1. (* 
  2.  * Enhanced 32-bit FileListBox (Freeware)
  3.  * 
  4.  * 
  5.  * Author: Paul K.F. Leung
  6.  * Date:   16th Dec, 95
  7.  * Email:  cs_paul@ug.cs.ust.hk
  8.  *)
  9.  
  10. unit File32;
  11.  
  12. interface
  13.  
  14. uses
  15.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  16.   Forms, Dialogs, StdCtrls, FileCtrl, Call32NT, LongName;
  17.  
  18. const
  19.   DefaultDir = 'c:\';
  20.   DefaultMask = '*.*';
  21.  
  22. type
  23.   ttime = array[0..1] of longint;
  24.   fd = record
  25.     dwFileAttributes:longint;
  26.     ftCreationTime,
  27.     ftLastAccessTime,
  28.     ftLastWriteTime:ttime;
  29.     nFileSizeHigh,
  30.     nFileSizeLow,
  31.     dwReserved0,
  32.     dwReserved1:longint;
  33.     cFileName:array[0..259] of char;
  34.     cAlternateFileName:array[0..13] of char;
  35.   end;
  36.   pfd = ^fd;
  37.  
  38.   TFileType = ( ftHidden , ftSystem, ftArchive, ftReadOnly );
  39.   TFileTypeSet = set of TFileType;
  40.  
  41.   TFile32ListBox = class(TListBox)
  42.   private
  43.     { Private declarations }
  44.     FDirectory : string;
  45.     FHandle:longint;
  46.     FFileType : TFileTypeSet;
  47.     FMask: string;
  48.     procedure SetDirectory(Value: string);
  49.   protected
  50.     { Protected declarations }
  51.   public
  52.     { Public declarations }
  53.     constructor Create(AOwner: TComponent); override;
  54.     procedure Update; override;
  55.   published
  56.     { Published declarations }
  57.     property Directory : string read FDirectory write SetDirectory;
  58.     property FileType : TFileTypeSet read FFileType write FFileType;
  59.     property Mask : string read FMask write FMask;
  60.   end;
  61.  
  62. procedure Register;
  63.  
  64. {Declaration of the 32 bit functions}
  65. var
  66.   W32FindFirstFile:
  67.     function(lpszSearchFile:pchar;var lpffd:fd;id:longint):longint;
  68.   W32FindNextFile:
  69.     function(hFindFile:longint;var lpffd:fd;id:longint):longbool;
  70.   W32FindClose:
  71.     function(hFindFile:longint;id:longint):Longbool;
  72.  
  73.   {Declaration of a unique identifier for each 32 bit function}
  74.   id_W32FindFirstFile,
  75.   id_W32FindNextFile,
  76.   id_W32FindClose : LongInt;
  77.   lr : fd;
  78.   localtime:ttime;
  79.   ok:longbool;
  80.   i:integer;
  81.  
  82.  
  83. implementation
  84.  
  85. constructor TFile32ListBox.Create(AOwner: TComponent);
  86. begin
  87.   inherited Create(AOwner);              {call inherited constructor}
  88.   FDirectory := DefaultDir;
  89.   FMask := DefaultMask;
  90. end;
  91.  
  92.  
  93. procedure TFile32ListBox.SetDirectory(Value: string);
  94. begin
  95.   if Value[Length(Value)] <> '\' then
  96.     FDirectory := Value + '\'
  97.   else
  98.     FDirectory := Value;
  99.   Update;
  100. end;
  101.  
  102.  
  103. procedure TFile32ListBox.Update;
  104. var
  105.   DirPtr : PChar;
  106.   tmp : string;
  107.   FAttr: LongInt;
  108. begin
  109.   tmp := FDirectory + Mask + #0;
  110.   FAttr := 0;
  111.   if ftArchive in FFileType then Inc(FAttr, 32);
  112.   if ftReadOnly in FFileType then Inc(FAttr, 1);
  113.   if ftHidden in FFileType then Inc(FAttr, 2);
  114.   if ftSystem in FFileType then Inc(FAttr, 4);
  115.   DirPtr := @tmp[1];
  116.   FHandle := W32FindFirstFile(DirPtr, lr, id_W32FindFirstFile);
  117.   Items.Clear;
  118.   if FHandle <> -1 then
  119.   repeat
  120.     if (StrComp(lr.cfilename, '.') <> 0) and
  121.        (StrComp(lr.cfilename, '..') <> 0) and
  122.        (lr.dwFileAttributes >= FAttr) then
  123.       Items.Add(StrPas(lr.cfilename));
  124.     ok:=W32FindNextFile(FHandle, lr, id_W32FindNextFile);
  125.   until not ok;
  126.   W32FindClose(FHandle, id_W32FindClose);
  127. end;
  128.  
  129.  
  130. procedure Register;
  131. begin
  132.   RegisterComponents('Samples', [TFile32ListBox]);
  133. end;
  134.  
  135.  
  136. initialization
  137.   {Initialization of the 32 bit functions}
  138.   @W32FindFirstFile:=@Call32;
  139.   @W32FindNextFile:=@Call32;
  140.   @W32FindClose:=@Call32;
  141.  
  142.   id_W32FindFirstFile:=Declare32('FindFirstFile', 'kernel32', 'pp');
  143.   id_W32FindNextFile:=Declare32('FindNextFile', 'kernel32', 'ip');
  144.   id_W32FindClose:=Declare32('FindClose', 'kernel32', 'i');
  145.  
  146.   {Check if everything went well. If there was only a single error,
  147.    Call32NTError=false}
  148.   if Call32NTError then begin
  149.     ShowMessage('FileListBox: Cannot load the desired 32 bit functions!');
  150.     halt(1);
  151.   end;
  152. end.
  153.  
  154.  
  155.